home *** CD-ROM | disk | FTP | other *** search
/ Sound Fx / Sound Fx.iso / Software / UNZIPED / DWSTK / PLAYDWM.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-10  |  8KB  |  292 lines
  1. (******************************************************************************
  2. File:              playdwm.pas
  3. Version:                     2.22
  4. Tab stops:         every 2 columns
  5. Project:           DWM Player
  6. Copyright:         1994-1995 DiamondWare, Ltd.  All rights reserved.
  7. Written:           Keith Weiner & Erik Lorenzen
  8. Pascal Conversion: David A. Johndrow
  9. DPMI Version:      Tom Repstad
  10. Purpose:           Contains simple example code to show how to load/play a
  11.                    .DWM file
  12. History:           94/10/21 KW Started playdwm.c
  13.                    94/11/12 DJ Translated to Pascal
  14.                    95/01/12 EL Finalized
  15.                    95/03/22 EL Finalized for 1.01
  16.                    95/04/11 EL Finalized for 1.02
  17.                                      95/06/06 EL Finalized for 1.03, no changes
  18.                                      95/06/06 EL Finalized for 2.00, no changes
  19.                                      95/10/16 EL Finalized for 2.10, cleaned up
  20.                    95/09/11 TR Protected Mode Version
  21.                                      95/10/24 EL Changed volumes to 95%, general cleanup
  22.                                      95/10/24 EL Finalized for 2.20
  23.                                      95/12/07 EL Finalized for 2.21, no changes
  24.                                      96/10/10 EL Finalized for 2.22, no changes
  25.  
  26. Notes
  27. -----
  28. This code isn't really robust when it comes to standard error checking
  29. and particularly recovery, software engineering technique, etc.  A buffer
  30. is statically allocated.  A better technique would be to use fstat() or stat()
  31. to determine the file's size then malloc(size).  The STK will handle songs
  32. larger than 64K (but not digitized sounds).  Obviously, you'd need to fread()
  33. such a file in chunks, or write some sort of hfread() (huge fread).  Also,
  34. exitting and cleanup is not handled robustly in this code.  The code below can
  35. only be validated by extremely careful scrutiny to make sure each case is
  36. handled properly.
  37.  
  38. But all such code would make this example file less clear; its purpose was
  39. to illustrate how to call the STK, not how to write QA-proof software.
  40. ******************************************************************************)
  41.  
  42.  
  43.  
  44. program playdwm;
  45.  
  46. {$IFDEF DPMI}
  47.     uses crt, err, mem, dws, winapi;
  48. {$ELSE}
  49.     uses crt, err, mem, dws;
  50. {$ENDIF}
  51.  
  52.  
  53. var
  54.     ExitSave:      pointer;
  55.  
  56.     song:              dws_ADDRESS;
  57.   songsize:    longint;
  58.   songplaying: word;
  59.  
  60.   dov:         dws_DOPTR;
  61.   dres:        dws_DRPTR;
  62.   ideal:       dws_IDPTR;
  63.     mplay:             dws_MPPTR;
  64.  
  65.   fp:          file;
  66.   ch:          char;
  67.   musvol:      word;
  68.  
  69.  
  70. function Exist(filename: string): boolean;
  71. var
  72.     fp: file;
  73.  
  74. begin
  75.     assign(fp, filename);
  76.   {$I- }
  77.     reset(fp);
  78.     close(fp);
  79.   {$I+ }
  80.  
  81.   Exist := (IOResult = 0);
  82. end;
  83.  
  84.  
  85. procedure ExitPlay; far;
  86.  
  87. label TRYTOKILLAGAIN;
  88.  
  89. begin
  90.   ExitProc := ExitSave;
  91.  
  92.   (* If dwt is not inited calling dwt_Kill will have no effect *)
  93.   dwt_Kill;
  94.  
  95. TRYTOKILLAGAIN:
  96.  
  97.   if (dws_Kill <> 1) then
  98.   begin
  99.     (*
  100.      . If an error occurs here, it's either dws_Kill_CANTUNHOOKISR
  101.      . or dws_NOTINITTED.  If it's dws_Kill_CANTUNHOOKISR the user
  102.      . must remove his tsr, and dws_Kill must be called again.  If it's
  103.      . dws_NOTINITTED, there's nothing to worry about at this point.
  104.     *)
  105.     err_Display;
  106.  
  107.     if (dws_ErrNo = dws_Kill_CANTUNHOOKISR) then
  108.     begin
  109.       goto TRYTOKILLAGAIN;
  110.     end;
  111.   end;
  112.  
  113.     {$IFDEF DPMI}
  114.     if (song.ptr <> nil) then
  115.     {$ELSE}
  116.     if (song <> nil) then
  117.     {$ENDIF}
  118.   begin
  119.         mem_FreeDOS(song, songsize);
  120.   end;
  121.  
  122.   dispose(mplay);
  123.   dispose(ideal);
  124.   dispose(dres);
  125.   dispose(dov);
  126. end;
  127.  
  128.  
  129. begin
  130.   ExitSave := ExitProc;
  131.   ExitProc := @ExitPlay;
  132.  
  133.   writeln;
  134.     writeln('PLAYDWM 2.22 is Copyright 1994-95, DiamondWare, Ltd.');
  135.   writeln('All rights reserved.');
  136.   writeln;
  137.   writeln;
  138.  
  139.   new(dov);
  140.   new(dres);
  141.   new(ideal);
  142.   new(mplay);
  143.  
  144.  
  145.     {$IFDEF DPMI}
  146.     song.ptr := nil;
  147.     {$ELSE}
  148.     song         := nil;
  149.     {$ENDIF}
  150.  
  151.     musvol     := 255; (* Default mxr volume at startup is max *)
  152.     ch             := '0';
  153.  
  154.   if (ParamCount = 0) then
  155.   begin
  156.     writeln('Usage PLAYDWM <dwm-file>');
  157.     halt(65535);
  158.   end;
  159.  
  160.   if Exist(ParamStr(1)) then
  161.   begin
  162.         assign(fp, ParamStr(1));
  163.         reset(fp,1);
  164.     songsize := filesize(fp);
  165.  
  166.     (* Please note we don't check to see if we get the memory we need. *)
  167.         mem_GetDOS(song, songsize);
  168.  
  169.         {$IFDEF DPMI}
  170.         blockread(fp, song.ptr^, songsize);
  171.         {$ELSE}
  172.         blockread(fp, song^, songsize);
  173.         {$ENDIF}
  174.  
  175.         close(fp);
  176.   end
  177.   else
  178.   begin
  179.     writeln('Unable to open '+ParamStr(1));
  180.     halt(65535);
  181.   end;
  182.  
  183.   (*
  184.    . We need to set every field to -1 in dws_DETECTOVERRIDES record; this
  185.    . tells the STK to autodetect everything.  Any other value
  186.    . overrides the autodetect routine, and will be accepted on
  187.    . faith, though the STK will verify it if possible.
  188.   *)
  189.   dov^.baseport := 65535;
  190.   dov^.digdma   := 65535;
  191.   dov^.digirq   := 65535;
  192.  
  193.   if (dws_DetectHardWare(dov, dres) = 0) then
  194.   begin
  195.     err_Display;
  196.     halt(65535);
  197.   end;
  198.  
  199.   (*
  200.    . The "ideal" record tells the STK how you'd like it to initialize the
  201.    . sound hardware.  In all cases, if the hardware won't support your
  202.    . request, the STK will go as close as possible.  For example, not all
  203.    . sound boards will support al sampling rates (some only support 5 or
  204.    . 6 discrete rates).
  205.   *)
  206.   ideal^.musictyp   := 1;     (*for now, it's OPL2 music*)
  207.   ideal^.digtyp     := 0;     (*0=No Dig, 8=8bit, 16=16bit*)
  208.   ideal^.digrate    := 0;     (*sampling rate, in Hz*)
  209.   ideal^.dignvoices := 0;     (*number of voices (up to 16)*)
  210.   ideal^.dignchan   := 0;     (*1=mono, 2=stereo*)
  211.  
  212.   if (dws_Init(dres, ideal) = 0) then
  213.   begin
  214.     err_Display;
  215.     halt(65535);
  216.   end;
  217.  
  218.   (*
  219.    .  72.8Hz is a decent compromise.  It will work in a Windows DOS box
  220.    .  without any problems, and yet it allows music to sound pretty good.
  221.    .  In my opinion, there's no reason to go lower than 72.8 (unless you
  222.    .  don't want the hardware timer reprogrammed)--music sounds kinda chunky
  223.    .  at lower rates.  You can go to 145.6 Hz, and get smoother (very
  224.    .  subtly) sounding music, at the cost that it will NOT run at the correct
  225.    .  (or constant) speed in a Windows DOS box.}
  226.   *)
  227.   dwt_Init(dwt_72_8HZ);
  228.  
  229.     (* Set music volume to about 95% max *)
  230.     musvol := 242;
  231.  
  232.   if (dws_XMusic(musvol) = 0) then
  233.   begin
  234.     err_Display;
  235.   end;
  236.  
  237.   mplay^.track := song;
  238.   mplay^.count := 1;
  239.  
  240.   if (dws_MPlay(mplay) = 0) then
  241.   begin
  242.     err_Display;
  243.     halt(65535);
  244.   end;
  245.  
  246.   (*
  247.    . We're playing.  Let's exit when the song is over, and allow the user
  248.    . to fiddle with the volume level (mixer) in the meantime
  249.   *)
  250.   writeln('Press + or - to change playback volume ');
  251.  
  252.   repeat
  253.   begin
  254.     if(dws_MSongStatus(@songplaying) = 0) then
  255.     begin
  256.       err_Display;
  257.       halt(65535);
  258.     end;
  259.  
  260.     if Keypressed then begin
  261.       ch := readkey;
  262.       case ord(ch) of
  263.         43:
  264.         begin
  265.           if (musvol < 255) Then
  266.             inc(musvol);
  267.           writeln('Music Volume is ', musvol);
  268.  
  269.           if (dws_XMusic(musvol) = 0) then
  270.           begin
  271.             err_Display;
  272.           end;
  273.         end;
  274.         45:
  275.         begin
  276.           if (musvol) > 0 then
  277.             dec(musvol);
  278.           writeln('Music Volume is ', musvol);
  279.  
  280.           if (dws_XMusic(musvol) = 0) then
  281.           begin
  282.             err_Display;
  283.           end;
  284.         end;
  285.       end;
  286.     end;
  287.   end;
  288.   until (songplaying = 0) or (ch = 'q') or (ch = 'Q') or (ch = chr(27));
  289.  
  290.     halt(0);
  291. end.
  292.